home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / telecom / 86 / modula / datese.mod < prev    next >
Encoding:
Text File  |  1986-12-19  |  5.7 KB  |  231 lines
  1. (**************************************************************
  2.  
  3.  
  4.  
  5. DATESET.PRG by Nigel Hearne,  Atari (UK),  5-Oct-1986
  6.  
  7.  
  8.  
  9. DATESET.PRG and DATE.TXT must live in the \AUTO folder.
  10.  
  11. DATE.TXT contains a string containing the date and an optional message eg.
  12.  
  13. 06/10/86Nigel  Hearne's  Disk...
  14.  
  15. The  optional message may be  up  to  50 characters long.
  16.  
  17.  
  18. When the date displays,  if it is the correct date, press CR else type the 
  19. entire date excluding slashes ie 210586 (the slashes will appear automati-
  20. cally).  If you changed the date it will be saved into DATE.TXT so if  you 
  21. re-boot during the day you don't have to keep re-setting the date. When
  22. typing, ESC will abort the process entirely;
  23.  
  24. Time: must be entered in 24 hour format excluding colon ie 1358, the colon 
  25. will automatically appear...
  26.  
  27. This is public domain software, do with it what you will!
  28.  
  29.  
  30. ************************************************************************)
  31.  
  32.  
  33.  
  34.  
  35. MODULE DateSet;
  36.  
  37. FROM GEMDOS IMPORT Open,
  38.                    Close,
  39.                    Read,
  40.                    Write,
  41.                    GetDate,
  42.                    SetDate,
  43.                    GetTime,
  44.                    SetTime,
  45.                    NecIn,
  46.                    ConOut;
  47.  
  48. FROM SYSTEM IMPORT ADR;
  49.  
  50.  
  51.                    
  52. TYPE Str20   = ARRAY[0..20] OF CHAR;
  53.      CharSet = SET OF CHAR;
  54.  
  55. CONST NumSet = CharSet{'0'..'9'};
  56.  
  57. VAR tCard,
  58.     dateTime : CARDINAL;
  59.     theFile  : INTEGER;
  60.     tLong    : LONGCARD;
  61.     abort    : BOOLEAN;
  62.     putBack  : BOOLEAN;
  63.     theData  : ARRAY[0..7] OF CHAR; (* 22/11/86 *)
  64.     message  : ARRAY[0..60] OF CHAR;
  65.     
  66. PROCEDURE WriteString( VAR s : ARRAY OF CHAR; len : INTEGER );
  67. VAR i : INTEGER;
  68. BEGIN
  69.   FOR i := 0 TO len-1 DO
  70.     ConOut( s[i] );
  71.   END;
  72. END WriteString;
  73.  
  74. PROCEDURE StringToNum( VAR s: ARRAY OF CHAR; start : CARDINAL): CARDINAL;
  75. BEGIN
  76.   RETURN CARDINAL(ORD(s[start])-48)*10 + CARDINAL(ORD(s[start+1])-48);
  77. END StringToNum;
  78.  
  79. (* Modula's realy mucky about here... *)
  80. PROCEDURE ShiftBits( VAR b: CARDINAL; shift: CARDINAL );
  81. VAR i,
  82.     c      : CARDINAL;
  83.     source,
  84.     target : BITSET;
  85. BEGIN
  86.   source := BITSET( b );
  87.   FOR c := 1 TO shift DO
  88.     target := {};
  89.     FOR i := 0 TO 14 DO
  90.       CASE i OF
  91.         0 : IF 0  IN source THEN INCL( target, 1 ); END;|
  92.         1 : IF 1  IN source THEN INCL( target, 2 ); END;|
  93.         2 : IF 2  IN source THEN INCL( target, 3 ); END;|
  94.         3 : IF 3  IN source THEN INCL( target, 4 ); END;|
  95.         4 : IF 4  IN source THEN INCL( target, 5 ); END;|
  96.         5 : IF 5  IN source THEN INCL( target, 6 ); END;|
  97.         6 : IF 6  IN source THEN INCL( target, 7 ); END;|
  98.         7 : IF 7  IN source THEN INCL( target, 8 ); END;|
  99.         8 : IF 8  IN source THEN INCL( target, 9 ); END;|
  100.         9 : IF 9  IN source THEN INCL( target, 10 ); END;|
  101.         10: IF 10 IN source THEN INCL( target, 11 ); END;|
  102.         11: IF 11 IN source THEN INCL( target, 12 ); END;|
  103.         12: IF 12 IN source THEN INCL( target, 13 ); END;|
  104.         13: IF 13 IN source THEN INCL( target, 14 ); END;|
  105.         14: IF 14 IN source THEN INCL( target, 15 ); END;|
  106.       ELSE END;
  107.     END;
  108.     source := target;
  109.   END;
  110.   b := CARDINAL( source );
  111. END ShiftBits;
  112.  
  113. PROCEDURE DoTime();
  114. VAR time : ARRAY [0..1] OF CHAR;
  115. BEGIN
  116.   dateTime := 0;
  117.   message  := 'Time: ';
  118.   WriteString( message, 6 );
  119.   ReadNumChar( time[0] );
  120.   ReadNumChar( time[1] );
  121.   tCard := StringToNum( time,0 ) * 2; (* Hours   *)
  122.   ShiftBits( tCard, 10 );
  123.   INC( dateTime, tCard );
  124.  
  125.   ConOut( ':' );
  126.   ReadNumChar( time[0] );
  127.   ReadNumChar( time[1] );
  128.   tCard := StringToNum( time, 0 );     (* Mins    *)
  129.   ShiftBits( tCard, 5 );
  130.   INC( dateTime, tCard );
  131.  
  132.   SetTime( dateTime );
  133. END DoTime;
  134.  
  135. PROCEDURE DoDate();
  136. VAR c    : CHAR;
  137.     i    : CARDINAL;
  138. BEGIN
  139.   message := 'Date: ';
  140.   WriteString( message, 6 );
  141.   ConOut( theData[0] );
  142.   ConOut( theData[1] );
  143.   ConOut( '/' );
  144.   ConOut( theData[3] );
  145.   ConOut( theData[4] );
  146.   ConOut( '/' );
  147.   ConOut( theData[6] );
  148.   ConOut( theData[7] );
  149.  
  150.   putBack := FALSE;
  151.   FOR i := 1 TO 8 DO
  152.     ConOut( 10C );
  153.   END;
  154.  
  155.   NecIn( c );
  156.   abort := c = 33C;
  157.   IF (c IN NumSet) AND (NOT abort) THEN
  158.     ConOut( c );
  159.     putBack := TRUE;
  160.     theData[2] := '/';
  161.     theData[5] := '/';
  162.     theData[0] := c;
  163.     ReadNumChar(theData[1]);
  164.     ConOut( '/' );
  165.     ReadNumChar(theData[3]);
  166.     ReadNumChar(theData[4]);
  167.     ConOut( '/' );
  168.     ReadNumChar(theData[6]);
  169.     ReadNumChar(theData[7]);
  170.   END;
  171.   
  172.   dateTime := 0;
  173.   tCard := StringToNum(theData,0);     (* Day    *)
  174.   ShiftBits( tCard, 0 );
  175.   INC( dateTime, tCard );
  176.     
  177.   tCard := StringToNum(theData,3);     (* Month  *)
  178.   ShiftBits( tCard, 5 );
  179.   INC( dateTime, tCard );
  180.     
  181.   tCard := StringToNum(theData,6);     (* Year   *)
  182.   INC( tCard, 20 );
  183.   ShiftBits( tCard, 9 );
  184.   INC( dateTime, tCard );
  185.  
  186.   SetDate( dateTime );
  187.   WriteLn;
  188. END DoDate;
  189.  
  190. PROCEDURE ReadNumChar( VAR c: CHAR );
  191. BEGIN
  192.   REPEAT 
  193.     NecIn( c );
  194.   UNTIL c IN NumSet;
  195.   ConOut( c );
  196.   
  197. END ReadNumChar;
  198.  
  199. PROCEDURE WriteLn();
  200. BEGIN
  201.   ConOut( 12C );
  202.   ConOut( 15C );
  203. END WriteLn;
  204.  
  205. BEGIN
  206.   WriteLn;
  207.   Open( '\AUTO\DATE.TXT', 0, theFile );
  208.   IF theFile >= 0 THEN
  209.     tLong := 8;
  210.     Read( theFile, tLong, ADR(theData) );
  211.     tLong := 60;
  212.     Read( theFile, tLong, ADR(message) );
  213.     IF Close( theFile ) THEN END;
  214.     WriteString( message, INTEGER(tLong) );
  215.     WriteLn;
  216.     WriteLn;
  217.     DoDate();
  218.     IF NOT abort THEN
  219.       DoTime();
  220.       IF putBack THEN
  221.         Open( '\AUTO\DATE.TXT', 2, theFile );
  222.         IF theFile >= 0 THEN
  223.           tLong := 8;
  224.           Write( theFile, tLong, ADR(theData) );
  225.           IF Close( theFile ) THEN END;
  226.         END;
  227.       END;
  228.     END;
  229.   END;
  230. END Preset.
  231.